The Programmer Disk/The Programmer Disk (Microforum).iso/xpro/vb1/pro21/iniio.bas

BASIC Source File | 1992-10-11 | 9KB | 207 lines

'
'   VB/DOS functions to act as DOS equivelants
'   to the Windows 3.x API calls:
'
'   1.  GetPrivateProfileInt
'   2.  GetPrivateProfileString
'   3.  WritePrivateProfileString
'
'   October 11th, 1992
'   by Raymond W. Six (CompuServe: 70530,433)
'
'   Public Domain Source Code!
'
DECLARE FUNCTION GetPrivateProfileInt (BYVAL lpApplicationName AS STRING, BYVAL lpKeyName AS STRING, BYVAL nDefault AS INTEGER, BYVAL lpFileName AS STRING) AS INTEGER
DECLARE FUNCTION GetPrivateProfileString (BYVAL lpApplicationName AS STRING, BYVAL lpKeyName AS STRING, BYVAL lpDefault AS STRING, lpReturnedString AS STRING, BYVAL nSize AS INTEGER, BYVAL lpFileName AS STRING) AS INTEGER
DECLARE FUNCTION WritePrivateProfileString (BYVAL lpApplicationName AS STRING, BYVAL lpKeyName AS STRING, BYVAL lpString AS STRING, BYVAL lpFileName AS STRING) AS INTEGER
REM $INCLUDE: 'C:\VBDOS\CONSTANT.BI'

FUNCTION GetPrivateProfileInt (BYVAL lpApplicationName AS STRING, BYVAL lpKeyName AS STRING, BYVAL nDefault AS INTEGER, BYVAL lpFileName AS STRING) AS INTEGER
     ON LOCAL ERROR GOTO GPPIErrorHandler:
     DIM FileNum AS INTEGER
     DIM LineOfText AS STRING
     DIM SectionFound AS INTEGER
     DIM SectionPassed AS INTEGER
     DIM LineFound AS INTEGER
     DIM SectionID AS STRING
     DIM LineID AS STRING
     DIM TempValue AS INTEGER
     FileNum = FREEFILE
     LineOfText = ""
     SectionFound = FALSE
     LineFound = FALSE
     SectionID = "[" + lpApplicationName + "]"
     LineID = lpKeyName + "="
     OPEN lpFileName FOR INPUT AS #FileNum
          DO UNTIL EOF(FileNum)
               LINE INPUT #FileNum, LineOfText
               IF NOT SectionFound THEN
                         '
                         '    start/continue to look for section identifier...
                         '
                         IF UCASE$(LEFT$(LineOfText, (LEN(SectionID)))) = UCASE$(SectionID) THEN
                              SectionFound = TRUE
                         END IF
                    ELSE
                         '
                         '    start/continue to look for line indentifier...
                         '
                         IF LEFT$(LineOfText, 1) = "[" THEN
                                   '
                                   '    section has been passed, give up...
                                   '
                                   EXIT DO
                              ELSE
                                   IF UCASE$(LEFT$(LineOfText, (LEN(LineID)))) = UCASE$(LineID) THEN
                                        '
                                        '    this is it!, use it and then exit...
                                        '
                                        LineFound = TRUE
                                        TempValue = VAL(RIGHT$(LineOfText, (LEN(LineOfText) - (LEN(LineID)))))
                                        IF TempValue > 0 THEN
                                                  GetPrivateProfileInt = TempValue
                                             ELSE
                                                  GetPrivateProfileInt = 0
                                        END IF
                                        EXIT DO
                                   END IF
                         END IF
               END IF
          LOOP
     CLOSE FileNum
GPPIUseDefault:
     IF NOT LineFound THEN
          GetPrivateProfileInt = nDefault
     END IF
     EXIT FUNCTION
GPPIErrorHandler:
     GetPrivateProfileInt = nDefault
     RESUME GPPIUseDefault:
     EXIT FUNCTION
END FUNCTION

FUNCTION GetPrivateProfileString (BYVAL lpApplicationName AS STRING, BYVAL lpKeyName AS STRING, BYVAL lpDefault AS STRING, lpReturnedString AS STRING, BYVAL nSize AS INTEGER, BYVAL lpFileName AS STRING) AS INTEGER
     ON LOCAL ERROR GOTO GPPSErrorHandler:
     DIM FileNum AS INTEGER
     DIM LineOfText AS STRING
     DIM SectionFound AS INTEGER
     DIM SectionPassed AS INTEGER
     DIM LineFound AS INTEGER
     DIM SectionID AS STRING
     DIM LineID AS STRING
     FileNum = FREEFILE
     LineOfText = ""
     SectionFound = FALSE
     LineFound = FALSE
     SectionID = "[" + lpApplicationName + "]"
     LineID = lpKeyName + "="
     OPEN lpFileName FOR INPUT AS #FileNum
          DO UNTIL EOF(FileNum)
               LINE INPUT #FileNum, LineOfText
               IF NOT SectionFound THEN
                         '
                         '    start/continue to look for section identifier...
                         '
                         IF UCASE$(LEFT$(LineOfText, (LEN(SectionID)))) = UCASE$(SectionID) THEN
                              SectionFound = TRUE
                         END IF
                    ELSE
                         '
                         '    start/continue to look for line indentifier...
                         '
                         IF LEFT$(LineOfText, 1) = "[" THEN
                                   '
                                   '    section has been passed, give up...
                                   '
                                   EXIT DO
                              ELSE
                                   IF UCASE$(LEFT$(LineOfText, (LEN(LineID)))) = UCASE$(LineID) THEN
                                        '
                                        '    this is it!, use it and then exit...
                                        '
                                        LineFound = TRUE
                                        lpReturnedString = LEFT$((RIGHT$(LineOfText, (LEN(LineOfText) - (LEN(LineID))))), nSize)
                                        EXIT DO
                                   END IF
                         END IF
               END IF
          LOOP
     CLOSE FileNum
GPPSUseDefault:
     IF NOT LineFound THEN
          lpReturnedString = LEFT$(lpDefault, nSize)
     END IF
     GetPrivateProfileString = LEN(lpReturnedString)
     EXIT FUNCTION
GPPSErrorHandler:
     lpReturnedString = LEFT$(lpDefault, nSize)
     GetPrivateProfileString = LEN(lpReturnedString)
     RESUME GPPSUseDefault:
     EXIT FUNCTION
END FUNCTION

FUNCTION WritePrivateProfileString (BYVAL lpApplicationName AS STRING, BYVAL lpKeyName AS STRING, BYVAL lpString AS STRING, BYVAL lpFileName AS STRING) AS INTEGER
     ON LOCAL ERROR GOTO WPPSErrorHandler:
     DIM FileNum AS INTEGER
     DIM LineOfText AS STRING
     DIM SectionFound AS INTEGER
     DIM LineFound AS INTEGER
     DIM SectionID AS STRING
     DIM LineID AS STRING
     FileNum = FREEFILE
     LineOfText = ""
     SectionFound = FALSE
     LineFound = FALSE
     SectionID = "[" + lpApplicationName + "]"
     LineID = lpKeyName + "="
     OPEN lpFileName FOR INPUT AS #FileNum
     OPEN "SecTemp.INI" FOR OUTPUT AS #(FileNum + 1)
          DO UNTIL EOF(FileNum)
               LINE INPUT #FileNum, LineOfText
               IF SectionFound = FALSE THEN
                         IF LEFT$(LineOfText, 1) = "[" THEN
                              IF UCASE$(LEFT$(LineOfText, (LEN(SectionID)))) = UCASE$(SectionID) THEN
                                   SectionFound = TRUE
                              END IF
                         END IF
                         PRINT #(FileNum + 1), LineOfText
                    ELSE
                         IF LEFT$(LineOfText, 1) = "[" THEN
                                   IF LineFound = FALSE THEN
                                        LineFound = TRUE
                                        PRINT #(FileNum + 1), (LineID + LTRIM$(RTRIM$(lpString)))
                                        PRINT #(FileNum + 1), ""
                                   END IF
                                   PRINT #(FileNum + 1), LineOfText
                              ELSE
                                   IF UCASE$(LEFT$(LineOfText, (LEN(LineID)))) = UCASE$(LineID) THEN
                                             LineFound = TRUE
                                             PRINT #(FileNum + 1), (LineID + LTRIM$(RTRIM$(lpString)))
                                        ELSE
                                             PRINT #(FileNum + 1), LineOfText
                                   END IF
                         END IF
               END IF
          LOOP
          IF SectionFound = FALSE THEN
                    PRINT #(FileNum + 1), SectionID
                    PRINT #(FileNum + 1), (LineID + LTRIM$(RTRIM$(lpString)))
               ELSE
                    IF LineFound = FALSE THEN
                         PRINT #(FileNum + 1), (LineID + LTRIM$(RTRIM$(lpString)))
                    END IF
          END IF
     CLOSE (FileNum + 1)
     CLOSE FileNum
     KILL lpFileName
     NAME "SecTemp.INI" AS lpFileName
     WritePrivateProfileString = -1
WPPSUseDefault:
     EXIT FUNCTION
WPPSErrorHandler:
     WritePrivateProfileString = 0
     RESUME WPPSUseDefault:
     EXIT FUNCTION
END FUNCTION